home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / ssavwin.exe / TRAPS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-29  |  4.8 KB  |  115 lines
  1. unit Traps;
  2.  
  3. {****************************************************************************
  4. *                                                                           *
  5. *    Einige Routinen, die Returncodes von Windows-Funktionen auswerten.     *
  6. *    (Hauptanwendung: "Sicherheitsnetz" während Programmentwicklung.)       *
  7. *                                                                           *
  8. *    Bei den eventuell angezeigten Fehleradressen ist CS natürlich nur      *
  9. *    beim Lauf unter dem Debugger aussagekräftig; bei Borlands "Find        *
  10. *    Error" muß man stattdessen die laufende Nummer des Segments eingeben.  *
  11. *                                                                           *
  12. ****--------------------------------------------------------------------*****
  13. *                                                                           *
  14. *    Compiler: TPWIN 1.5                                                    *
  15. *                                                                           *
  16. ****--------------------------------------------------------------------*****
  17. *                                                                           *
  18. *    Rev. 1.0   11.2.92   MK  IR                                            *
  19. *    Rev. 1.1   11.8.92   MK  Einige Meldungstexte verändert                *
  20. *                                                                           *
  21. ****************************************************************************}
  22.  
  23. interface
  24.  
  25. uses Winprocs, Wintypes;
  26.  
  27. function TestHandle (TheHandle: THandle): THandle;
  28. procedure TestBool (TheValue: bool);
  29.  
  30. implementation
  31.  
  32. {****************************************************************************
  33. *                                                                           *
  34. *                       T e s t H a n d l e                                 *
  35. *                                                                           *
  36. *  AUFGABE: Überprüft ein Handle;                                           *
  37. *               bricht mit Returncode 10 ab, falls Handle 0                 *
  38. *                                                                           *
  39. *  EINGABE: TheHandle = zu überprüfendes Handle                             *
  40. *                                                                           *
  41. *  HINWEIS: Das Programm wird brutal über HALT gestoppt: kein Aufräumen!    *
  42. *                                                                           *
  43. ****************************************************************************}
  44.  
  45. function TestHandle (TheHandle: THandle): THandle;
  46.  
  47. var retadr:   array [0..1] of word;
  48.     rcs, rip: word;
  49.     OutText:  array [0..50] of char;
  50.  
  51. begin
  52. if (TheHandle <> 0) then            { ok }
  53.      TestHandle := TheHandle
  54.    else
  55.      begin
  56.      asm
  57.          mov ax,[bp+4]              { hole Returnadresse }
  58.          mov rcs,ax
  59.          mov ax,[bp+2]
  60.          mov rip,ax
  61.          end;  { asm }
  62.      retadr [0] := rcs;
  63.      retadr [1] := rip-5;           { = Offset des Calls }
  64.  
  65.      wvsprintf (OutText, 'Handle = 0 at address %X:%X', retadr);
  66.      MessageBox (0, OutText, 'Fatal Error', MB_IconStop or MB_OK);
  67.  
  68.      halt (10);
  69.      end; { else }
  70.  
  71. end; { TestHandle }
  72.  
  73. {****************************************************************************
  74. *                                                                           *
  75. *                       T e s t B o o l                                     *
  76. *                                                                           *
  77. *  AUFGABE: Überprüft einen logischen Wert;                                 *
  78. *               bricht mit Returncode 11 ab, falls Wert = false             *
  79. *                                                                           *
  80. *  EINGABE: TheValue = zu überprüfender logischer Wert                      *
  81. *                                                                           *
  82. *  HINWEIS: Das Programm wird brutal über HALT gestoppt: kein Aufräumen!    *
  83. *                                                                           *
  84. ****************************************************************************}
  85.  
  86. procedure TestBool (TheValue: bool);
  87.  
  88. var retadr:   array [0..1] of word;
  89.     rcs, rip: word;
  90.     OutText:  array [0..50] of char;
  91.  
  92. begin
  93. if (TheValue = false) then
  94.      begin
  95.      asm
  96.          mov ax,[bp+4]              { hole Returnadresse }
  97.          mov rcs,ax
  98.          mov ax,[bp+2]
  99.          mov rip,ax
  100.          end;  { asm }
  101.      retadr [0] := rcs;
  102.      retadr [1] := rip-5;           { = Offset des Calls }
  103.  
  104.      wvsprintf (OutText, 'API-Function failed at address %X:%X', retadr);
  105.      MessageBox (0, OutText, 'Fatal Error', MB_IconStop or MB_OK);
  106.  
  107.      halt (11);
  108.      end; { if false }
  109.  
  110. end; { TestBool }
  111.  
  112.  
  113. begin
  114. end.
  115.